home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8311.arc / INBASIC5.BAS < prev    next >
BASIC Source File  |  1984-01-25  |  7KB  |  168 lines
  1. 10 ' BASIC program cross reference
  2. 20 GOSUB 110 ' initialize
  3. 30 GOSUB 280 ' ask user
  4. 40 GOSUB 360 ' start up
  5. 50 GOSUB 420 ' identify tokens
  6. 60 GOSUB 1190 ' sort tokens
  7. 70 GOSUB 1360 ' print tokens
  8. 80 END
  9. 90 '
  10. 100 ' *** INITIALIZE ***
  11. 110 DEFINT A-Z : DEF SEG : OPTION BASE 1
  12. 120 A=0:C$="":T$="":C=1:I=0:J=0:K=0:L=0:M=0:X=0:Y=0:Z=0:B=0:D=0:H=0
  13. 130 T1$=CHR$(1) : T2$=CHR$(2) : T3$=CHR$(3) : T4$=CHR$(4) : T5$=CHR$(5)
  14. 140 DIM S[20,2]
  15. 150 DIM CK$[124] : FOR I=1 TO 124 : READ CK$[I] : NEXT
  16. 160 DATA END,FOR,NEXT,DATA,INPUT,DIM,READ,LET,GOTO,RUN,IF,RESTORE,GOSUB,RETURN,REM,STOP,PRINT,CLEAR,LIST,NEW,ON,WAIT,DEF,POKE,CONT,"?","?",OUT,LPRINT,LLIST,"?",WIDTH,ELSE
  17. 170 DATA TRON,TROFF,SWAP,ERASE,EDIT,ERROR,RESUME,DELETE,AUTO,RENUM,DEFSTR,DEFINT,DEFSNG,DEFDBL,LINE,WHILE,WEND,CALL,"?","?","?",WRITE,OPTION,RANDOMIZE,OPEN,CLOSE,LOAD,MERGE,SAVE,COLOR
  18. 180 DATA CLS,MOTOR,BSAVE,BLOAD,SOUND,BEEP,PSET,PRESET,SCREEN,KEY,LOCATE,"?",TO,THEN,TAB(,STEP,USR,FN,SPC(,NOT,ERL,ERR,STRING$,USING,INSTR,"'",VARPTR,CSRLIN,POINT,OFF,INKEY$,"?","?"
  19. 190 DATA "?","?","?","?","?",">","=","<","+","-","*","/","^","AND","OR","XOR","EQV","IMP","MOD","\","?","?","?","?","?","?","?","?"
  20. 200 DIM CF$[37] : FOR I=1 TO 37 : READ CF$[I] : NEXT
  21. 210 DATA LEFT$,RIGHT$,MID$,SGN,INT,ABS,SQR,RND,SIN,LOG,EXP,COS,TAN,ATN,FRE,INP,POS,LEN,STR$,VAL,ASC,CHR$,PEEK,SPACE$,OCT$,HEX$,LPOS,CINT,CSNG,CDBL,FIX,PEN,STICK,STRIG,EOF,LOC,LOF
  22. 220 DIM DK$[30] : FOR I=1 TO 30 : READ DK$[I] : NEXT
  23. 230 DATA FILES,FIELD,SYSTEM,NAME,LSET,RSET,KILL,PUT,GET,RESET,COMMON,CHAIN,DATE$,TIME$,PAINT,COM,CIRCLE,DRAW,PLAY,TIMER,IOTCTL,MKDIR,SHELL,VIEW,PMAP,ERDEV,CHDIR,RMDIR,ENVIRON,WINDOW
  24. 240 DIM DF$[6] : FOR I=1 TO 6 : READ DF$[I] : NEXT
  25. 250 DATA CVI,CVS,CVD,MKI$,MKS$,MKD$
  26. 260 RETURN
  27. 270 '
  28. 280 ' *** ASK USER ***
  29. 290 INPUT "FILE NAME";X$ : OPEN X$ AS #1 LEN 128 : FIELD #1, 128 AS BB$ : C=129
  30. 300 DIM S$[2000],P[2000] 'low memory?
  31. 310 PRINT "EACH OF THESE CAN BE LISTED:" : PRINT "KEYWORDS, VARIABLES, LINE NUMBERS, NUMBERS, STRINGS": INPUT "LIST (K,V,L,N,S)";Y$
  32. 320 Z$="KVLNS"
  33. 330 FOR I=1 TO LEN(Y$) : O[INSTR(Z$,MID$(Y$,I,1))]=-1 : NEXT
  34. 340 RETURN
  35. 350 '
  36. 360 ' *** START UP ***
  37. 370 PRINT "ANALYZING"
  38. 380 FOR I=1 TO 3:GOSUB 1520:NEXT
  39. 390 GOSUB 1520 : B=A : GOSUB 1520 : L=B+256*A
  40. 400 PRINT STR$(L); : RETURN
  41. 410 '
  42. 420 ' *** IDENTIFY TOKENS ***
  43. 430 GOSUB 1520:IF EF THEN 1170
  44. 440 IF A<128 THEN 630
  45. 450 ' *** KEYWORDS ***
  46. 460 IF A=143 THEN 550 ' REMARK?
  47. 470 IF A=132 THEN 590 ' DATA?
  48. 480 IF A<253 THEN X=252 ELSE X=A:GOSUB 1520
  49. 490 ON X-251 GOTO 500,510,520,530
  50. 500 T$=CK$[A-128]:GOTO 540 ' Cassette keyword
  51. 510 T$=DF$[A-128]:GOTO 540 ' Disk function
  52. 520 T$=DK$[A-128]:GOTO 540 ' Disk keyword
  53. 530 T$=CF$[A-128]:GOTO 540 ' Cassette function
  54. 540 T$=T1$+T$:GOTO 1140
  55. 550 ' *** REMARK ***
  56. 560 T$="":GOSUB 1520:IF A<>217 THEN T$=T$+C$
  57. 570 GOSUB 1520:IF 0=A THEN GOSUB 1640 ELSE T$=T$+C$:GOTO 570
  58. 580 GOTO 1160
  59. 590 ' *** DATA ***
  60. 600 T$=""
  61. 610 GOSUB 1520:IF 0=A THEN GOSUB 1640 ELSE T$=T$+C$:GOTO 610
  62. 620 GOTO 1160
  63. 630 IF A<65 OR A>90 THEN 680
  64. 640 ' *** NAME ***
  65. 650 T$=C$
  66. 660 GOSUB 1520:IF(A>64 AND A<91)OR(A>47 AND A<58)OR A=46 OR A=33 OR A=35 OR A=36 OR A=37 THEN T$=T$+C$:GOTO 660 ELSE GOSUB 1640
  67. 670 T$=T2$+T$:GOTO 1140
  68. 680 IF A<>14 THEN 720
  69. 690 ' *** LINE NUMBER ***
  70. 700 GOSUB 1520:B=A:GOSUB 1520:T$=STR$(B+256*A)
  71. 710 T$=T3$+T$:GOTO 1140
  72. 720 IF A<>34 THEN 770
  73. 730 ' *** LITERAL CONSTANT ***
  74. 740 T$=C$
  75. 750 GOSUB 1520:T$=T$+C$:IF A=34 THEN 760 ELSE 750
  76. 760 T$=T5$+T$:GOTO 1140
  77. 770 IF A<17 OR A>26 THEN 810
  78. 780 ' *** 1 DECIMAL DIGIT CONSTANT ***
  79. 790 T$=STR$(A-17)
  80. 800 T$=T4$+T$:GOTO 1140
  81. 810 IF A<>15 THEN 850
  82. 820 ' *** 1 BYTE INTEGER CONSTANT ***
  83. 830 GOSUB 1520:T$=STR$(A)
  84. 840 T$=T4$+T$:GOTO 1140
  85. 850 IF A<>28 THEN 890
  86. 860 ' *** 2 BYTE SIGNED INTEGER ***
  87. 870 GOSUB 1520:B=A:GOSUB 1520:T$=STR$(B+256*A)+"%"
  88. 880 T$=T4$+T$:GOTO 1140
  89. 890 IF A<>29 THEN 940
  90. 900 ' *** 4 BYTE FLOATING POINT ***
  91. 910 T$="":X=VARPTR(N!)
  92. 920 FOR I=0 TO 3:GOSUB 1520:POKE X+I,A:NEXT:T$=STR$(N!)+"!"
  93. 930 T$=T4$+T$:GOTO 1140
  94. 940 IF A<>31 THEN 990
  95. 950 ' ***** 8 BYTE FLOATING POINT *****
  96. 960 T$="":X=VARPTR(N#)
  97. 970 FOR I=0 TO 7:GOSUB 1520:POKE X+I,A:NEXT:T$=STR$(N#)+"#"
  98. 980 T$=T4$+T$:GOTO 1140
  99. 990 IF A<>11 AND A<>12 THEN 1030
  100. 1000 ' *** 2 BYTE HEX/OCTAL INTEGER ***
  101. 1010 GOSUB 1520:B=A:GOSUB 1520:T$=STR$(B+A*256)+"&"
  102. 1020 T$=T4$+T$:GOTO 1140
  103. 1030 IF A=32 OR A=35 OR A=40 OR A=41 OR A=44 OR A=45 OR A=58 OR A=59 OR A=91 OR A=93 THEN 1160
  104. 1040 IF A<>0 THEN 1090
  105. 1050 ' *** END OF LINE ***
  106. 1060 GOSUB 1520 : B=A : GOSUB 1520 : IF A=0 AND B=0 THEN EF=1 : RETURN
  107. 1065 GOSUB 1520 : B=A : GOSUB 1520 : L=B+256*A
  108. 1070 IF L<>0 THEN PRINT STR$(L); : GOTO 1160 ELSE 1170
  109. 1080 ' *** OTHER ***
  110. 1090 IF A>47 AND A<58 THEN STOP ' ASCII digits are impossible
  111. 1100 IF A>96 AND A<122 THEN STOP ' lower case letters are impossible
  112. 1110 IF A<11 OR A=13 OR A=15 OR A=16 OR A=30 THEN STOP ' impossible
  113. 1120 STOP ' A wasn't an ASCII value
  114. 1130 ' *** STORE TOKEN ***
  115. 1140 IF NOT O[ASC(LEFT$(T$,1))] THEN 1160
  116. 1150 K=K+1:S$[K]=T$:P[K]=L
  117. 1160 GOTO 430
  118. 1170 RETURN
  119. 1180 '
  120. 1190 ' *** SORT TOKENS ***
  121. 1200 PRINT:PRINT "SORTING"
  122. 1210 D=1:S[D,1]=1:S[D,2]=K
  123. 1220 WHILE D>0:L=S[D,1]:H=S[D,2]:D=D-1
  124. 1230 IF L>=H THEN 1340
  125. 1240 I=L:J=H:X=H
  126. 1250 WHILE(I<J)AND(S$[I]<=S$[X]):I=I+1:WEND
  127. 1260 WHILE(J>I)AND(S$[J]>=S$[X]):J=J-1:WEND
  128. 1270 IF I<J THEN SWAP S$[I],S$[J] : SWAP P[I],P[J]
  129. 1275 IF I<J THEN 1250
  130. 1280 SWAP S$[I],S$[H] : SWAP P[I],P[H]
  131. 1290 IF (I-L)<(H-I)THEN  1320
  132. 1300 D=D+1:S[D,1]=L:S[D,2]=I-1
  133. 1310 D=D+1:S[D,1]=I+1:S[D,2]=H:GOTO 1340
  134. 1320 D=D+1:S[D,1]=I+1:S[D,2]=H
  135. 1330 D=D+1:S[D,1]=L:S[D,2]=I-1:GOTO 1340
  136. 1340 WEND : RETURN
  137. 1350 '
  138. 1360 ' *** PRINT LISTING ***
  139. 1370 C=0:FOR I=1 TO K:IF LEN(S$[I])>C THEN C=LEN(S$[I])
  140. 1380 NEXT
  141. 1390 CR$=CHR$(13) : M=K : K=0 : P$=CR$ : DIM L[100]
  142. 1400 FOR I=1 TO M:T$=MID$(S$[I],2)
  143. 1410 IF P$=T$ THEN K=K+1:L[K]=P[I]:GOTO 1480
  144. 1420 IF P$=CR$ THEN K=1:P$=T$:L[K]=P[I]:GOTO 1480
  145. 1430 IF K=1 THEN 1460
  146. 1440 FOR X=1 TO K:FOR Y=X TO K:IF L[X]>L[Y] THEN SWAP L[X],L[Y]
  147. 1450 NEXT:NEXT
  148. 1460 LPRINT:LPRINT LEFT$(P$+SPACE$(C),C);:FOR J=1 TO K:LPRINT L[J];:NEXT
  149. 1470 K=1:P$=T$:L[K]=P[I]
  150. 1480 NEXT
  151. 1490 LPRINT:LPRINT LEFT$(P$+SPACE$(C),C);:FOR J=1 TO K:LPRINT L[J];:NEXT:LPRINT
  152. 1500 RETURN
  153. 1510 '
  154. 1520 ' *** GET CHAR, ADVANCE CURSOR ***
  155. 1530 IF C<129 THEN 1560 'more chars?
  156. 1540 P$=B$ ' save buffer
  157. 1550 GET #1 : B$ = BB$ : C=1
  158. 1560 C$=MID$(B$,C,1) : A=ASC(C$) : C=C+1
  159. 1570 IF SW=0 AND A=255 THEN SW=1 : A=0
  160. 1580 RETURN
  161. 1590 P$=B$:B$=INPUT$(128,#1)
  162. 1600 C=1:J=J+128
  163. 1610 C$=MID$(B$,C,1):A=ASC(C$):C=C+1:RETURN
  164. 1620 '
  165. 1630 ' *** RETRACT CURSOR ***
  166. 1640 IF C=1 THEN B$=P$ : C=128 ELSE C=C-1
  167. 1650 RETURN
  168.